home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1256 / tour001.co_ / tour001.co
Text File  |  1997-04-18  |  9KB  |  231 lines
  1.       *---Created with EasyCODE(COB)----------------------------------- # EASY O
  2.       *---Last modification: 01.03.1995 14:22:50----------------------- # EASY K
  3.       *This program is used for opening a session.
  4.       *---------------------------------------------------------------- # EASY *
  5.       *---------------------------------------------------------------- # EASY (
  6.       *TOUR001
  7.       *---------------------------------------------------------------- # EASY *
  8.        IDENTIFICATION DIVISION.
  9.       *---------------------------------------------------------------- # EASY (
  10.       **** Identification Division ***
  11.       *---------------------------------------------------------------- # EASY *
  12.        PROGRAM-ID. TOUR001.
  13.       *
  14.       *
  15.       * THIS PROGRAM IS USED FOR OPENING A SESSION.
  16.       * ITS TAC : BEGINNING.
  17.       *
  18.       *
  19.       *---------------------------------------------------------------- # EASY )
  20.        ENVIRONMENT DIVISION.
  21.        DATA DIVISION.
  22.       *---------------------------------------------------------------- # EASY (
  23.       **** Data Division ***
  24.       *---------------------------------------------------------------- # EASY *
  25.       *---------------------------------------------------------------- # EASY (
  26.       **** WORKING-STORAGE Section ***
  27.       *---------------------------------------------------------------- # EASY *
  28.        WORKING-STORAGE SECTION.
  29.        COPY KCOPC.
  30.        COPY KCDFC.
  31.       *                                 # EASY S
  32.       *---------------------------------------------------------------- # EASY )
  33.       *---------------------------------------------------------------- # EASY (
  34.       **** LINKAGE Section ***
  35.       *---------------------------------------------------------------- # EASY *
  36.        LINKAGE SECTION.
  37.      COPY KCKBC.
  38.         05 MENU-MESSAGE  PIC X(80).
  39.       
  40.      COPY KCPAC.
  41.       
  42.         03 EMPLOYEES.
  43.            COPY EMPLOY.
  44.       
  45.         03 SESSION.
  46.            COPY SESSION.
  47.       
  48.         03 NB          PIC X(80).
  49.       
  50.         03 ERROR-LINE-1 REDEFINES NB.
  51.            05 FILLER      PIC X(80).
  52.       
  53.         03 ERROR-LINE-2 REDEFINES NB.
  54.            05 RET-CODE    PIC X(3).
  55.            05 OCCURRED-AT           PIC X(5).
  56.            05 OP-CODE     PIC X(4).
  57.            05 FILLER      PIC X(68).
  58.       
  59.         03 ERROR-SIGN       PIC 9.
  60.       *                                 # EASY S
  61.       *---------------------------------------------------------------- # EASY )
  62.       *---------------------------------------------------------------- # EASY )
  63.        PROCEDURE DIVISION USING KCKBC KCSPAB.
  64.       *---------------------------------------------------------------- # EASY (
  65.       **** Procedure Division ***
  66.       *---------------------------------------------------------------- # EASY *
  67.       *---------------------------------------------------------------- # EASY (
  68.       **** INIT-OPERATION ***
  69.       *---------------------------------------------------------------- # EASY *
  70.        INIT-OPERATION.
  71.        MOVE INIT TO KCOP
  72.       *                                 # EASY -
  73.        MOVE 80 TO KCLKBPRG
  74.       *                                 # EASY -
  75.        MOVE 1000 TO KCLPAB
  76.        CALL "KDCS" USING KCPAC
  77.        IF KCRCCC NOT = "000"
  78.        THEN
  79.           PERFORM ERROR-MPUT-OPERATION
  80.           PERFORM ERROR-PEND-OPERATION
  81.        END-IF
  82.        .
  83.       *                                 # EASY P
  84.       *---------------------------------------------------------------- # EASY )
  85.       *---------------------------------------------------------------- # EASY (
  86.       **** PROCESSING ***
  87.       *---------------------------------------------------------------- # EASY *
  88.        PROCESSING.
  89.        PERFORM START-SESSION
  90.        .
  91.       *                                 # EASY P
  92.       *---------------------------------------------------------------- # EASY )
  93.       *---------------------------------------------------------------- # EASY (
  94.       **** PEND-OPERATION ***
  95.       *---------------------------------------------------------------- # EASY *
  96.        PEND-OPERATION.
  97.        MOVE PEND TO KCOP
  98.       *                                 # EASY -
  99.        MOVE "PR" TO KCOM
  100.       *                                 # EASY -
  101.        MOVE "MENUOUT" TO KCRN
  102.        CALL "KDCS" USING KCPAC
  103.        .
  104.       *                                 # EASY P
  105.       *---------------------------------------------------------------- # EASY )
  106.       *---------------------------------------------------------------- # EASY (
  107.       **** ERROR-PEND-OPERATION ***
  108.       *---------------------------------------------------------------- # EASY *
  109.        ERROR-PEND-OPERATION.
  110.        MOVE PEND TO KCOP
  111.       *                                 # EASY -
  112.        MOVE "ER" TO KCOM
  113.        CALL "KDCS" USING KCPAC
  114.        .
  115.       *                                 # EASY P
  116.       *---------------------------------------------------------------- # EASY )
  117.       *---------------------------------------------------------------- # EASY (
  118.       **** ERROR-MPUT-OPERATION ***
  119.       *---------------------------------------------------------------- # EASY *
  120.        ERROR-MPUT-OPERATION.
  121.        MOVE SPACES TO ERROR-LINE-2
  122.        MOVE KCRCCC TO RET-CODE
  123.        MOVE " AT " TO OCCURRED-AT
  124.        MOVE KCOP TO OP-CODE
  125.        MOVE MPUT TO KCOP
  126.        MOVE "NE" TO KCOM
  127.        MOVE 12 TO KCLM
  128.        MOVE SPACES TO KCMF, KCRN
  129.        MOVE KCALARM TO KCDF
  130.        CALL "KDCS" USING KCPAC, NB
  131.        .
  132.       *                                 # EASY P
  133.       *---------------------------------------------------------------- # EASY )
  134.       *---------------------------------------------------------------- # EASY (
  135.       **** END-OF-PROGRAM ***
  136.       *---------------------------------------------------------------- # EASY *
  137.        END-OF-PROGRAM.
  138.        EXIT PROGRAM
  139.        .
  140.       *                                 # EASY P
  141.       *---------------------------------------------------------------- # EASY )
  142.       *---------------------------------------------------------------- # EASY (
  143.       **** START-SESSION ***
  144.       *---------------------------------------------------------------- # EASY *
  145.        START-SESSION.
  146.        PERFORM SGET-OPERATION
  147.        ADD 1 TO SESSIONS OF EMPLOYEES
  148.        PERFORM SPUT-OPERATION
  149.        PERFORM PTDA-OPERATION
  150.        MOVE SPACES TO MENU-MESSAGE
  151.        .
  152.       *                                 # EASY P
  153.       *---------------------------------------------------------------- # EASY )
  154.       *---------------------------------------------------------------- # EASY (
  155.       **** PTDA-OPERATION ***
  156.       *---------------------------------------------------------------- # EASY *
  157.        PTDA-OPERATION.
  158.        MOVE KCTAGVG TO CURRENT-DAY OF SESSION
  159.       *                                 # EASY -
  160.        MOVE KCMONVG TO CURRENT-MONTH OF SESSION
  161.       *                                 # EASY -
  162.        MOVE KCJHRVG TO CURRENT-YEAR OF SESSION
  163.       *                                 # EASY -
  164.        MOVE KCUHRVG TO CURRENT-TIME OF SESSION
  165.       *                                 # EASY -
  166.        MOVE ZEROES TO BOOKINGS OF SESSION,
  167.        BOOKED-SEATS OF SESSION
  168.       *                                 # EASY -
  169.        MOVE PTDA TO KCOP
  170.       *                                 # EASY -
  171.        MOVE 22 TO KCLA
  172.       *                                 # EASY -
  173.        MOVE "SESSION" TO KCRN
  174.        CALL "KDCS" USING KCPAC, SESSION
  175.        .
  176.       *                                 # EASY P
  177.       *---------------------------------------------------------------- # EASY )
  178.       *---------------------------------------------------------------- # EASY (
  179.       **** SGET-OPERATION ***
  180.       *---------------------------------------------------------------- # EASY *
  181.        SGET-OPERATION.
  182.        MOVE LOW-VALUES TO KCPAC
  183.       *                                 # EASY -
  184.        MOVE SGET TO KCOP
  185.       *                                 # EASY -
  186.        MOVE "US" TO KCOM
  187.       *                                 # EASY -
  188.        MOVE 18 TO KCLA
  189.       *                                 # EASY -
  190.        MOVE "MASTAT" TO KCRN
  191.       *                                 # EASY -
  192.        MOVE SPACES TO KCUS
  193.       *                                 # EASY -
  194.        MOVE ZEROES TO EMPLOYEES
  195.        CALL "KDCS" USING KCPAC, EMPLOYEES
  196.        IF KCRCCC NOT = "000"
  197.        THEN
  198.           PERFORM ERROR-MPUT-OPERATION
  199.           PERFORM ERROR-PEND-OPERATION
  200.        END-IF
  201.        .
  202.       *                                 # EASY P
  203.       *---------------------------------------------------------------- # EASY )
  204.       *---------------------------------------------------------------- # EASY (
  205.       **** SPUT-OPERATION ***
  206.       *---------------------------------------------------------------- # EASY *
  207.        SPUT-OPERATION.
  208.        MOVE LOW-VALUES TO KCPAC
  209.       *                                 # EASY -
  210.        MOVE SPUT TO KCOP
  211.       *                                 # EASY -
  212.        MOVE "US" TO KCOM
  213.       *                                 # EASY -
  214.        MOVE 18 TO KCLA
  215.       *                                 # EASY -
  216.        MOVE "MASTAT" TO KCRN
  217.       *                                 # EASY -
  218.        MOVE SPACES TO KCUS
  219.        CALL "KDCS" USING KCPAC, EMPLOYEES
  220.        IF KCRCCC NOT = "000"
  221.        THEN
  222.           PERFORM ERROR-MPUT-OPERATION
  223.           PERFORM ERROR-PEND-OPERATION
  224.        END-IF
  225.        .
  226.       *                                 # EASY P
  227.       *---------------------------------------------------------------- # EASY )
  228.       *---------------------------------------------------------------- # EASY )
  229.        END PROGRAM TOUR001.
  230.       *---------------------------------------------------------------- # EASY )
  231.